BBS in a Box 3/BBS in a box - Trilogy III.iso/Files/Prog/A/AciusTN8-92/GraphicalButtonsƒ/ButtonPkg-US/ButtonPackage.p

Text File | 1992-10-10 | 17.1 KB | 708 lines | [TEXT/MPS ]

{$D+}
{$R+}
{écrit par François Marchal, © ACI 1991}
{Version 1.3}

{Historique des versions :
  0.5 Première version sous formes de routines indépendantes
      implémentée dans 4D Desk
  1.0 Intégration dans un package externe
          Implémentation de : Activer/Inactiver
                                  Valeurs par défaut
                                  Display Methode
          Parution dans la note technique NT23
  1.1 Optimisation des IdleEvent
          Implémentation dans la démo QuickTime
  1.2 Gestion de la validité des paramètres
          Signature des Handles
  1.3 Gestion du disabled pour les boutons radios
  1.4 Suppression du double appel par ENTRYPOINT
  1.5 Gestion des boutons en offscreen
  1.6 Correction d'un gros bug à l'Update Event:
          La ressource du bloc est maintenant lockée
        avant le DrawButton. Le problème était aléatoire
        sans les offscreens, et fréquent depuis.
}

Unit Button_Pack4D;

Interface

Uses Memory, QuickDraw, OSIntf, Toolintf, PackIntf, Events, QDOffscreen, Access0;
Type
        ParamBloc = record
                        DefaultstdPICTResUp,
                        DefaultstdPICTResDown,
                        DefaultstdPICTDisabled,
                        DefaultrbPICTResUp,
                        DefaultrbPICTResDown,
                        DefaultrbPICTDisabled,
                        DefaultFont,
                        DefaultSize,
                        DefaultStyle,
                        DefaultUpXOffset,
                        DefaultUpYOffset,
                        DefaultDownXOffset,
                        DefaultDownYOffset,
                        DefaultJumpedChar,
                        DefaultDisplayMethod : Integer;
                    end;
        ParamBlocPtr = ^ParamBloc;
        ParamBlocHandle = ^ParamBlocPtr;

        Bloc =         record
                        Signature : longint;
                        PICTResUp,
                        PICTResDown,
                        PICTDisabled,
                        FontButton,
                        SizeButton,
                        StyleButton,
                        UpXOffset,
                        UpYOffset,
                        DownXOffset,
                        DownYOffset,
                        DisplayMethod : Integer;
                        TitleButton    :    Str255;
                        clicked  : Integer;
                        enabled    : Boolean;
                        AreaRect : Rect;
                    end;
        BlocPtr = ^Bloc;
        BlocHandle = ^BlocPtr;

Const
        stdPicUpLocalRes           = 1;
        stdPicDownLocalRes        = 2;
        rbPicUpLocalRes           = 3;
        rbPicDownLocalRes            = 4;
        down                            = 1;
        up                                = 0;
        inactif                        = -1;
        RadioButton                    = 1;
        StandardButton                = 2;
        PictScale                    = 1;
        AreaScale                    = 2;
        ValidSignature                = $464D4250; {'FMBP'}


Procedure thePackage(ProcNum:Longint; PtrList:PackageVariablesPtr; Var Data:ParamBlocHandle; Var FuncPtr:PackRetParam);
Procedure DrawButton(var TheBloc : BlocHandle; var TheRect : Rect; state : Integer);
procedure DrawStructure( TheParamBloc : ParamBlocHandle; TheName : Str255; TheType : Integer; TheRect : Rect);
Function isValid(TheBloc : BlocHandle) : boolean;
Procedure Button_ExternalArea(    var    TheEvent : EventRecord;
                                            var    TheRect     : Rect;
                                            var    TheName     : Str255;
                                            var    TheBloc     : BlocHandle;
                                            var    TheParamBloc : ParamBlocHandle;
                                                    TheType  : Integer);

Implementation

Procedure thePackage(ProcNum:Longint; PtrList:PackageVariablesPtr; Var Data:ParamBlocHandle; Var FuncPtr:PackRetParam);
Var
    TheInt : Integer;
    TheBloc : BlocHandle;

Begin
    Case ProcNum Of

        1    : { ButtonExternalArea }
        if PtrList^[1].EV^.what <> NullEvent then
            if Data<>Nil then
            begin
                HLock(handle(Data));
                Button_ExternalArea(PtrList^[1].EV^,
                                          PtrList^[2].RE^,
                                          PtrList^[3].S^,
                                          BlocHandle(PtrList^[4].HH^),
                                          Data,
                                          StandardButton);
                HUnLock(handle(Data));
            end;{if Data<>Nil}


        2    :    {RadioButtonExternalArea}
        if PtrList^[1].EV^.what <> NullEvent then
            if Data<>Nil then
            begin
                HLock(handle(Data));
                Button_ExternalArea(PtrList^[1].EV^,
                                          PtrList^[2].RE^,
                                          PtrList^[3].S^,
                                          BlocHandle(PtrList^[4].HH^),
                                          Data,
                                          RadioButton);
                HUnLock(handle(Data));
            end;    {if Data<>Nil}

        (-1)    :
        Begin    {Init Package}
            Data := ParamBlocHandle(NewHandle(SizeOf(ParamBloc)));
            if Data <> Nil then
            begin
                Hlock(Handle(Data));
                With Data^^ do
                begin
                    DefaultstdPICTResUp:=GetResNum('4BNX','PICT',stdPicUpLocalRes);
                    DefaultstdPICTResDown:=GetResNum('4BNX','PICT',stdPicDownLocalRes);
                    DefaultrbPICTResUp:=GetResNum('4BNX','PICT',rbPicUpLocalRes);
                    DefaultrbPICTResDown:=GetResNum('4BNX','PICT',rbPicDownLocalRes);
                    DefaultstdPICTDisabled:=(-1);
                    DefaultrbPICTDisabled:=(-1);
                    DefaultJumpedChar:=1;
                    DefaultFont:=0;
                    DefaultSize:=12;
                    DefaultStyle:=0;
                    DefaultUpXOffset:=(-1);
                    DefaultUpYOffset:=(-1);
                    DefaultDownXOffset:=0;
                    DefaultDownYOffset:=0;
                    DefaultDisplayMethod:= PictScale;
                end;    {With Data^^}
                HUnLock(Handle(Data));
            end;    {if Data<>Nil}
        end; {InitPackage}


        (-2)    : {DeInit Package}
        if Data<>Nil then DisposHandle(handle(Data));


        3    :    {GetButton}
        Begin
            TheBloc:=BlocHandle(PtrList^[1].HH^);
            if isValid(TheBloc) then
                With TheBloc^^ do
                begin
                    FuncPtr.I:=clicked;
                    if clicked=down then    clicked:=up;
                end;
        end; {GetButton}


        4    :    {ReadButton}
        Begin
            TheBloc:=BlocHandle(PtrList^[1].HH^);
            if isValid(TheBloc) then
                    FuncPtr.I:=TheBloc^^.clicked;
        end; {ReadButton}


        5    :    {SetRadioButton}
        Begin
            TheBloc:=BlocHandle(PtrList^[1].HH^);
            if isValid(TheBloc) then
                TheInt:=PtrList^[2].I^;
                if (TheInt=1) or (TheInt=0) then
                    if TheBloc^^.clicked<>TheInt then
                    begin
                        TheBloc^^.clicked:=TheInt;
                        InValRect(TheBloc^^.AreaRect);
                    end;
        end; {Case 5}


        6    :    {DisableButton}
        Begin
            TheBloc:=BlocHandle(PtrList^[1].HH^);
            if isValid(TheBloc) then
                if TheBloc^^.enabled then
                begin
                    TheBloc^^.enabled:=False;
                    InValRect(TheBloc^^.AreaRect);
                end;
        end; {DisableButton}


        7    :    {EnableButton}
        Begin
            TheBloc:=BlocHandle(PtrList^[1].HH^);
            if isValid(TheBloc) then
                if not(TheBloc^^.enabled) then
                begin
                    TheBloc^^.enabled:=True;
                    InValRect(TheBloc^^.AreaRect);
                end;
        end; {EnableButton}


        8    :    {SetPICTButton}
        Begin
            TheBloc:=BlocHandle(PtrList^[1].HH^);
            if isValid(TheBloc) then
                With TheBloc^^ do
                begin
                    if PtrList^[2].I^ >=0         then PICTResUp     := PtrList^[2].I^;
                    if PtrList^[3].I^ >=0         then PICTResDown     := PtrList^[3].I^;
                    if PtrList^[4].I^ >=(-1)     then PICTDisabled    := PtrList^[4].I^;
                    InValRect(TheBloc^^.AreaRect);
                end;    {With TheBloc^^ do}
        end; {SetPICTButton}


        9    :    {SetButtonTitle}
        Begin
            TheBloc:=BlocHandle(PtrList^[1].HH^);
            if isValid(TheBloc) then
                With TheBloc^^ do
                begin
                    TitleButton:=PtrList^[2].S^;
                    if PtrList^[3].I^ >=0 then FontButton :=PtrList^[3].I^;
                    if PtrList^[4].I^ >=0 then SizeButton :=PtrList^[4].I^;
                    if PtrList^[5].I^ >=0 then StyleButton:=PtrList^[5].I^;
                    InValRect(TheBloc^^.AreaRect);
                end; {With TheBloc^^}
        end; {SetButtonTitle}


        10    :    {SetButtonOffset}
        Begin
            TheBloc:=BlocHandle(PtrList^[1].HH^);
            if isValid(TheBloc) then
                With TheBloc^^ do
                begin
                    UpXOffset := PtrList^[2].I^;
                    UpXOffset := PtrList^[3].I^;
                    UpXOffset := PtrList^[4].I^;
                    UpXOffset := PtrList^[5].I^;
                    InValRect(TheBloc^^.AreaRect);
                end;
        End;    {SetButtonOffset}


        11 :    {SetDisplayMethod}
        begin
            TheBloc:=BlocHandle(PtrList^[1].HH^);
            if isValid(TheBloc) then
                With TheBloc^^ do
                begin
                    case PtrList^[2].I^ of
                        PictScale :
                            DisplayMethod:=PictScale;
                        AreaScale :
                            DisplayMethod:=AreaScale;
                    end; {Case PtrList^[2].I^}
                    InValRect(TheBloc^^.AreaRect);
                end;
        end;

        12    :    {SetDefaultPICT}
            if Data <> Nil then
            begin
                HLock(Handle(Data));
                With Data^^ do
                begin
                    if PtrList^[1].I^>0 then
                        DefaultstdPICTResUp:=PtrList^[1].I^
                    else
                        if PtrList^[1].I^=0 then
                            DefaultstdPICTResUp:=GetResNum('4BNX','PICT',stdPicUpLocalRes);

                    if PtrList^[2].I^>0 then
                        DefaultstdPICTResDown:=PtrList^[2].I^
                    else
                        if PtrList^[2].I^=0 then
                            DefaultstdPICTResDown:=GetResNum('4BNX','PICT',stdPicDownLocalRes);

                    if PtrList^[3].I^>(-2) then DefaultstdPICTDisabled:=PtrList^[3].I^;

                    if PtrList^[4].I^>0 then
                        DefaultrbPICTResUp:=PtrList^[4].I^
                    else
                        if PtrList^[4].I^=0 then
                            DefaultrbPICTResUp:=GetResNum('4BNX','PICT',rbPicUpLocalRes);

                    if PtrList^[5].I^>0 then
                        DefaultrbPICTResDown:=PtrList^[5].I^
                    else
                        if PtrList^[5].I^=0 then
                            DefaultrbPICTResDown:=GetResNum('4BNX','PICT',rbPicDownLocalRes);

                    if PtrList^[6].I^>(-2) then DefaultrbPICTDisabled:=PtrList^[6].I^;

                end;    {With Data^^}
                HUnLock(Handle(Data));
            end;

        13    :    {SetDefaultStyle}
            if Data <> Nil then
                With Data^^ do
                begin
                    DefaultJumpedChar:=PtrList^[1].I^;
                    if PtrList^[2].I^>=0 then
                        DefaultFont:=PtrList^[2].I^;
                    if PtrList^[3].I^>=0 then
                        DefaultSize:=PtrList^[3].I^;
                    if PtrList^[4].I^>=0 then
                        DefaultStyle:=PtrList^[4].I^;
                end;    {With Data^^}


        14    :    {SetDefaultOffset}
            if Data <> Nil then
                With Data^^ do
                begin
                    DefaultUpXOffset:=PtrList^[1].I^;
                    DefaultUpYOffset:=PtrList^[2].I^;
                    DefaultDownXOffset:=PtrList^[3].I^;
                    DefaultDownYOffset:=PtrList^[4].I^;
                end;    {With Data^^}

        15 : {SetDefaultDisplayMethod}
            if Data <> Nil then
            begin
                case PtrList^[1].I^ of
                    PictScale :
                        Data^^.DefaultDisplayMethod:=PictScale;
                    AreaScale :
                        Data^^.DefaultDisplayMethod:=AreaScale;
                end;
            end;

        16 : {Convert FontName to FontNum}
            begin
                GetFNum(PtrList^[1].S^,TheInt);
                FuncPtr.L:=Longint(TheInt);
            end;

    end;    {case ProcNum}
end;    {procedure ENTRYPOINT}

Procedure DrawButton(var TheBloc : BlocHandle; var TheRect : Rect; state : Integer);
var
    ThePict         : PicHandle;
    PictRect        : Rect;
    TextPoint     : Point;
    FntInfo        : FontInfo;
    FntHeight    : Integer;
    Trame            : Pattern;
    TheMaxPixelSize         : integer;
    TheMaxRect                 : Rect;
    TheMaxDevice             : GDHandle;
    TheMaxCTable             : CTabHandle;
    ThePictureGWorld,
    currPort                 : CGrafPtr;
    currdev                    : GDHandle;
    err                         : QDErr;
    isLock                     : boolean;
begin
    With TheBloc^^ do
    begin
        if enabled or (PICTDisabled<>0) then
        begin
            if not(enabled) and (PICTDisabled<>(-1)) then
                ThePict:=GetPicture(PICTDisabled)
            else
                if state = up then
                    ThePict:=GetPicture(PICTResUp)
                else
                    ThePict:=GetPicture(PICTResDown);

            if ThePict<>Nil then
            begin
                Case DisplayMethod of
                    PictScale :
                    begin
                        PictRect:=ThePict^^.picFrame;
                        offsetRect(PictRect,-PictRect.left,-PictRect.top);
                        offsetRect(PictRect,TheRect.left,TheRect.top);
                    end;
                    AreaScale :
                        PictRect:=TheRect;
                end; {Case DisplayMethod}

                GetGWorld(currport,currDev);

                TheMaxRect:=GetGrayRgn^^.rgnBBox;
                TheMaxDevice:=GetMaxDevice(TheMaxRect);
                TheMaxPixelSize:=TheMaxDevice^^.gdPMap^^.pixelsize;
                TheMaxCTable:=TheMaxDevice^^.gdPMap^^.pmTable;

                Err:=NewGWorld(ThePictureGWorld,TheMaxPixelSize,PictRect,TheMaxCTable,Nil,[]);

                if Err=NoErr then
                begin
                    SetGWorld(ThePictureGWorld,Nil);
                    IsLock:=LockPixels(ThePictureGWorld^.portPixmap);
                    EraseRect(PictRect);
                end
                else
                    SetGWorld(currport,currDev);

                DrawPicture(ThePict, PictRect);

                if length(TitleButton) > 0 then
                begin
                    TextFont(FontButton);
                    TextSize(SizeButton);
                    TextFace(style(byte(StyleButton)));
                    TextMode(SrcOr);
                    GetFontInfo(FntInfo);
                    FntHeight:=FntInfo.Ascent+FntInfo.Descent;
                    TextPoint.h:=    PictRect.Left
                            +(((PictRect.Right-PictRect.Left)
                            -Stringwidth(TitleButton))div 2);
                    TextPoint.v:=    PictRect.Bottom
                            -(((PictRect.Bottom-PictRect.top)-FntHeight) div 2)
                            -fntinfo.Descent;
                    if state = up then
                        MoveTo(TextPoint.h+UpXOffset,
                                 TextPoint.v+UpYOffset)
                    else
                        MoveTo(TextPoint.h+DownXOffset,
                                 TextPoint.v+DownYOffset);
                    DrawString(TitleButton);
                end;
                if not(enabled) and (PICTDisabled=(-1)) then
                begin
                    GetIndPattern(Trame,SysPatListID,4);
                    PenMode(patBic);
                    PenPat(Trame);
                    PaintRect(PictRect);
                end;


                if Err=NoErr then
                begin
                    SetGWorld(currport,currDev);
                    UnlockPixels(ThePictureGWorld^.portPixmap);
                    Copybits(GrafPtr(ThePictureGWorld)^.portBits,GrafPtr(currport)^.portbits, PictRect, PictRect, srcCopy, Nil);
                    DisposeGWorld(ThePictureGWorld);
                end;

            end;
        end;
    end;
end;


procedure DrawStructure( TheParamBloc : ParamBlocHandle; TheName : Str255; TheType : Integer; TheRect : Rect);
var
    ThePict : PicHandle;
    PictRect    : Rect;
begin
    With TheParamBloc^^ do
    begin
        case TheType of
            StandardButton :
                ThePict := GetPicture(DefaultstdPICTResUp);
            RadioButton :
                ThePict := GetPicture(DefaultrbPICTResUp);
        end;
        if ThePict<>Nil then
        begin
            PenNormal;
            Case DefaultDisplayMethod of
                PictScale :
                begin
                    PictRect:=ThePict^^.picFrame;
                    offsetRect(PictRect,-PictRect.left,-PictRect.top);
                    offsetRect(PictRect,TheRect.left,TheRect.top);
                end;
                AreaScale :
                    PictRect:=TheRect;
            end;
            DrawPicture(ThePict,PictRect);
            FrameRect(TheRect);
            MoveTo(TheRect.left+5,TheRect.top+10);
            TextFont(1);
            TextSize(9);
            TextFace([]);
            TextMode(SrcOr);
            DrawString(TheName);
        end;
    end;
end;

Function isValid(TheBloc : BlocHandle) : boolean;
var
    i : integer;
    v : boolean;
begin
    v:=false;
    if TheBloc<>Nil then
        if GetHandleSize(handle(TheBloc))>0 then
            if TheBloc^^.Signature=ValidSignature then
                v:=True;
    if not(v) then i:=Alert(GetResNum('4BNX','ALRT',0),Nil);
    isValid:=v;
end;


Procedure Button_ExternalArea(    var    TheEvent : EventRecord;
                                            var    TheRect     : Rect;
                                            var    TheName     : Str255;
                                            var    TheBloc     : BlocHandle;
                                            var    TheParamBloc : ParamBlocHandle;
                                                    TheType  : Integer);
var
    ThePoint    : Point;
    DejaInRect,
    IsInRect    : Boolean;

begin
    If TheParamBloc <> Nil then
    case TheEvent.What of

        MouseDown:
        begin
            if isValid(TheBloc) then
            begin
                Hlock(handle(TheBloc));
                With TheBloc^^ do
                begin
                    if enabled then
                        Case TheType of
                            StandardButton :
                            begin
                                DrawButton(TheBloc,TheRect,down);
                                Clicked:=Down;
                                While Stilldown do
                                begin
                                    GetMouse(ThePoint);
                                    if PtInRect(ThePoint,TheRect) then
                                    begin
                                        if Clicked=Up then
                                        begin
                                            DrawButton(TheBloc,TheRect,down);
                                            Clicked:=Down;
                                        end;
                                    end
                                    else
                                    begin
                                        if Clicked=Down then
                                        begin
                                            DrawButton(TheBloc,TheRect,up);
                                            Clicked:=Up;
                                        end;
                                    end;
                                end; {Stilldown}
                                if clicked=Down then DrawButton(TheBloc,TheRect,up);
                            end; {Case StandardButton}


                            RadioButton :
                            begin
                                if Clicked=Down then
                                    Clicked:=Up
                                else
                                    Clicked:=Down;

                                DrawButton(TheBloc,TheRect,clicked);
                                DejaInRect:=True;

                                While Stilldown do
                                begin
                                    GetMouse(ThePoint);
                                    IsInRect:=ptinrect(ThePoint,TheRect);
                                    if IsInRect<>DejaInRect then
                                    begin
                                        if Clicked=Down then
                                            Clicked:=Up
                                        else
                                            Clicked:=Down;
                                        DrawButton(TheBloc,TheRect,clicked);
                                        DejaInRect:=IsInRect;
                                    end;
                                end; {While Stilldown}
                            end; {RadioButton}
                        end {Case TheType}
                    else
                        Clicked:=inactif;
                    end;    {With TheBloc^^}
                HUnlock(handle(TheBloc));
            end;{if TheBloc<>Nil}
        end; {Case MouseDown}

        StructEvent:
        begin
            DrawStructure(TheParamBloc,TheName,TheType,TheRect);
            TheEvent.Message:=ZoneIsCustomized;
        end;


        UpdateEvt:
            if isValid(TheBloc) then
            begin
                Hlock(handle(TheBloc));
                case TheType of
                    StandardButton :
                        DrawButton(TheBloc,TheRect,up);
                    RadioButton :
                        DrawButton(TheBloc,TheRect,TheBloc^^.clicked);
                end;
                HUnlock(handle(TheBloc));
            end;

        InitEvent:
        begin
            TheBloc:=BlocHandle(NewHandle(sizeof(Bloc)));
            if TheBloc <> Nil    then
            begin
                Hlock(handle(TheBloc));
                with TheBloc^^, TheParamBloc^^ do
                begin
                    Signature:=ValidSignature;
                    TitleButton:='';
                    case TheType of
                        StandardButton :
                        begin
                            PICTResUp:=DefaultstdPICTResUp;
                            PICTResDown:=DefaultstdPICTResDown;
                            PICTDisabled:=DefaultstdPICTDisabled;
                            if  (DefaultJumpedChar>=0)
                              & (DefaultJumpedChar<length(TheName)) then
                                TitleButton:=Copy(TheName,
                                                        1+DefaultJumpedChar,
                                                        Length(TheName)-DefaultJumpedChar);
                            end;    {StandardButton}
                        RadioButton :
                        begin
                            PICTResUp:=DefaultrbPICTResUp;
                            PICTResDown:=DefaultrbPICTResDown;
                            PICTDisabled:=DefaultrbPICTDisabled;
                        end;    {RadioButton}
                    end;    {Case TheType}
                    clicked:=up;
                    enabled:=True;
                    FontButton:=DefaultFont;
                    SizeButton:=DefaultSize;
                    StyleButton:=DefaultStyle;
                    UpXOffset:=DefaultUpXOffset;
                    UpYOffset:=DefaultUpYOffset;
                    DownXOffset:=DefaultDownXOffset;
                    DownYOffset:=DefaultDownYOffset;
                    DisplayMethod:=DefaultDisplayMethod;
                    AreaRect:=TheRect;
                end; {with TheBloc^^, TheParamBloc^^}
                HUnlock(handle(TheBloc));
            end; {if TheBloc<>Nil}
        end; {InitEvent}

        DeInitEvent:
            if isValid(TheBloc) then DisposHandle(handle(TheBloc));

    end; {Case TheEvent.What}
end; {Button_ExternalArea}

end.



{ Script de compilation pour MPW 3.2

Pascal ButtonPackage.p

Link -p  ButtonPackage.p.o ∂
             interface.o ∂
             PasLib.o ∂
             Access0.o ∂
     -m    THEPACKAGE ∂
    -sg Main=PASLIB ∂
    -rt 4DPX=26000 ∂
    -sn 'Main'='Button Package' ∂
    -t    'PEXT' ∂
    -c    '4DMX' ∂
    -o    ButtonPackage.Ext
}